perm filename DRAWX.F4[3,LMM] blob
sn#038923 filedate 1973-05-01 generic text, type T, neo UTF8
00100 IMPLICIT INTEGER (A-Z)
00150 COMMON/OFN/OFN
00200 COMMON LINE(20,4),NODE(20,4),STACK(1000)
00300 COMMON LLN,NLN,S,L,FLN,RA,RI
00400 DIMENSION ITIT(10,20),ITMP(20)
00500 DIMENSION IPAT(2,11,5)
00600 DIMENSION CONN(20,10)
00700 DIMENSION BN(10,10)
00800 REAL SQRT,FLOAT
00900 DATABLANS/4H /, IEND/4HEND*/
01000 DATA CONN /200*0/
01100 DATA BN/100*0/
01200 DATA IPAT/1,2,1,3,1,4,2,3,2,4,3,4,8*0,2,0,
01300 1 1,2,2,3,3,4,4,5,5,6,6,3,2,5,1,4,6,1,0,0,3,1,
01400 1 1,2,1,3,1,4,1,5,2,3,2,4,2,5,6*0,2,0,
01500 2 44*0/
01600 IFN=1
01700 RMX=70
01800 NSTR=0
01900
00100 C READ NEXT DATA SET FROM (IFN)
00200 C
00300 30 LLN=0
00400 NLN=0
00500 READ(IFN,1012,END=20) IAA, OFN
00600 1012 FORMAT(I5,I3)
00700 IF (OFN.EQ.0)OFN=5
00800 IF (IAA.GT.0) GO TO 17
00900 NSTR=-IAA-1
01000 READ(IFN,1012,END=20) IAA
01100 17 CONTINUE
00100 DO 13 I=1,20
00200 13 CONN(I,1)=1
00300 DO 4 IAB=1,IAA
00400 READ(IFN,1009) ITMP(1),IA,(ITMP(I),I=2,20)
00500 IF (ITMP(1).EQ.0) GO TO 5
00600 NODE(ITMP(1),3)=IA
00700 NLN=MAX0(NLN,ITMP(1))
00800 DO 1 I=2,20
00900 IF (ITMP(I).EQ.0) GO TO 4
01000 IF (LLN.EQ.0) GO TO 7
01100 DO 2 IA=1,LLN
01200 IB=IA
01300 IF (LINE(IA,1).EQ.ITMP(1).AND.LINE(IA,2).EQ.ITMP(I)) GO TO 3
01400 IF (LINE(IA,2).EQ.ITMP(1).AND.LINE(IA,1).EQ.ITMP(I)) GO TO 1
01500 2 CONTINUE
01600 7 LLN=LLN+1
01700 LINE(LLN,1)=ITMP(1)
01800 LINE(LLN,2)=ITMP(I)
01900 LINE(LLN,3)=1
02000 LINE(LLN,4)=0
02100 12 CONN(ITMP(1),1)=CONN(ITMP(1),1)+1
02200 CONN(ITMP(1),CONN(ITMP(1),1))=ITMP(I)
02300 CONN(ITMP(I),1)=CONN(ITMP(I),1)+1
02400 CONN(ITMP(I),CONN(ITMP(I),1))=ITMP(1)
02500 GO TO 1
02600 3 LINE(IB,3)=LINE(IB,3)+1
02700 1 CONTINUE
02800 4 CONTINUE
02850 3421 FORMAT(3I10)
02900 5 FLN=1
03000 8 IAA=1
03100 9 READ(IFN,1001)(ITIT(IAA,I),I=1,18)
03200 IAA=IAA+1
03300 IF (ITIT(IAA-1,1).NE.IEND) GO TO 9
03375 4317 FORMAT(4H OFN,I5)
03400 IAA=IAA-2
00100 C PRINT INPUT INFO
00200 C
00300 10 IF (IAA.NE.0) WRITE(OFN,1003) ((ITIT(I,IA),IA=1,18),I=1,IAA)
00400 NSTR=NSTR+1
00500 FLN=FLN-1
00600 GO TO 60
00100 C END OF RUN
00200 C
00300 20 CONTINUE
00400 DO 21 I=1,10
00500 IB=I-1
00600 DO 21 IA=1,10
00700 IC=IA-1
00800 21 CONTINUE
00900 STOP
00100 C INPUT/OUTPUT FORMATS
00200 C
00300 1001 FORMAT(18A4)
00400 1002 FORMAT(20I2)
00500 1003 FORMAT(1H ,10(18A4/))
00600 1004 FORMAT(5X,10HLINE TABLE/19H FROM TO #BONDS)
00700 1005 FORMAT(1H ,I3,3X,I3,4X,I3)
00800 1006 FORMAT(///11H FACE TABLE//)
00900 1007 FORMAT(1H ,10I3)
01000 1008 FORMAT(13H1BOND SUMMARY//3X,2HTB,3X,2HDB,3X,6HNUMBER//)
01100 1009 FORMAT(I3,1X,A1,1X,19I3)
01200 1013 FORMAT(1H1,10HSTRUCTURE ,I4///)
01300 1014 FORMAT(1H ,2I5,I7)
01400 1239 FORMAT(A4)
00100 C SORT LINES FOR USAGE COUNT
00200 C
00300 60 IA=LLN-1
00400 DO 41 I=1,IA
00500 IC=CONN(LINE(I,1),1)+CONN(LINE(I,2),1)
00600 IAA=I+1
00700 DO 41 IB=IAA,LLN
00800 ID=CONN(LINE(IB,1),1)+CONN(LINE(IB,2),1)
00900 IF (IC.GE.ID) GO TO 41
01000 DO 42 IE=1,4
01100 LA=LINE(I,IE)
01200 LINE(I,IE)=LINE(IB,IE)
01300 42 LINE(IB,IE)=LA
01400 IC=ID
01500 41 CONTINUE
01600 C
01700 C SORT LINES ACCORDING TO SIDE ARMS (DISCONNECTED)
01800 C
01900 DO 70 I=1,NLN
02000 70 NODE(I,1)=0
02100 DO 71 I=1,LLN
02200 NODE(LINE(I,1),1)=NODE(LINE(I,1),1)+1
02300 71 NODE(LINE(I,2),1)=NODE(LINE(I,2),1)+1
02400 NXN=LLN
02500 83 DO 72 I=1,NLN
02600 IF(NODE(I,1).NE.1) GO TO 72
02700 DO 73 IA=1,LLN
02800 IB=IA
02900 IF (LINE(IA,1).EQ.I.OR.LINE(IA,2).EQ.I) GO TO 74
03000 73 CONTINUE
03100 74 NXN=NXN-1
03200 IF (IB.GT.NXN) GO TO 84
03300 DO 75 IC=1,4
03400 ID=LINE(IB,IC)
03500 DO 76 IA=IB,NXN
03600 76 LINE(IA,IC)=LINE(IA+1,IC)
03700 75 LINE(NXN+1,IC)=ID
03800 IB=NXN+1
03900 84 NODE(LINE(IB,1),1)=NODE(LINE(IB,1),1)-1
04000 NODE(LINE(IB,2),1)=NODE(LINE(IB,2),1)-1
04100 GO TO 83
04200 72 CONTINUE
00100 C SORT LINE FOR NEWLY ALL DEFINED
00200 C
00300 DO 61 I=1,NLN
00400 61 ITMP(I)=0
00500 ITMP(LINE(1,1))=NLN+1
00600 ITMP(LINE(1,2))=NLN
00700 IG=NLN-1
00800 I=2
00900 62 IA=I
01000 MX=0
01100 ML=0
01200 MN=0
01300 68 L1=LINE(IA,1)
01400 L2=LINE(IA,2)
01500 IF(ITMP(L1).EQ.0.AND.ITMP(L2).EQ.0) GO TO 78
01600 IF (ITMP(L1).EQ.0.OR.ITMP(L2).EQ.0) GO TO 63
01700 64 IF (I.EQ.IA) GO TO 65
01800 IB=IA-1
01900 DO 66 IC=1,4
02000 LA=LINE(IA,IC)
02100 DO 67 ID=I,IB
02200 67 LINE(IB+I-ID+1,IC)=LINE(IB+I-ID,IC)
02300 66 LINE(I,IC)=LA
02400 65 I=I+1
02500 IF (I.GE.NXN) GO TO 79
02600 GO TO 62
02700 78 IA=IA+1
02800 IF (IA.LE.NXN.AND.ML.NE.-1) GO TO 68
02900 IA=ML
03000 IF (ML.GT.0) ITMP(MN)=IG
03100 ML=-1
03200 IF (IA.GT.0) GO TO 64
03300 IG=IG-1
03400 IF (IA.EQ.0) GO TO 79
03500 GO TO 62
03600 63 IE=L1
03700 IF (ITMP(L1) .NE. 0) IE=L2
03800 IB=0
03900 IBA=CONN(IE,1)
04000 DO 77 IC=2,IBA
04100 77 IB=IB+ITMP(CONN(IE,IC))
04200 IF (IB.LE.MX) GO TO 78
04300 ML=IA
04400 MX=IB
04500 MN=IE
04600 GO TO 78
04700 79 CONTINUE
00100 C GET TOP SIDE INFO
00200 C
00300 DO 150 I=1,NLN
00400 150 NODE(I,4)=0
00500 NODE(LINE(1,1),4)=-1
00600 NODE(LINE(1,2),4)=-1
00700 NA=LINE(2,1)
00800 IF (NA.NE.LINE(1,1).AND.NA.NE.LINE(1,2)) GO TO 151
00900 NA=LINE(2,2)
01000 151 NODE(NA,4)=1
01100 DO 154 ID=1,1
01200 DO 152 I=1,NLN
01300 IA=NODE(I,4)
01400 IF (IA.NE.0) GO TO 152
01500 IAA=CONN(I,1)
01600 DO 153 IB=2,IAA
01700 IF (NODE(CONN(I,IB),4).GT.0) GO TO 155
01800 153 CONTINUE
01900 GO TO 152
02000 155 NODE(I,4)=-10
02100 152 CONTINUE
02200 DO 156 I=1,NLN
02300 156 IF (NODE(I,4).EQ.-10) NODE(I,4)=1
02400 154 CONTINUE
00100 C CHECK FOR COMPLICATED PATTERNS
00200 C
00300 RI=0
00400 RA=1
00500 C
00600 C INITIALIZE--SET FIRST NODE
00700 C
00800 50 DO 100 I=1,NLN
00900 NODE(I,1)=0
01000 100 NODE(I,2)=0
01100 STACK(1)=-1
01200 NODE(LINE(1,1),1)=50
01300 NODE(LINE(1,1),2)=50
01400 LV=1
01500 S=1
01600 LN=1
01700 STACK(1)=-1
01800 C
01900 C NEXT LINE
02000 C
02100 114 L1=LINE(LN,1)
02200 L2=LINE(LN,2)
02300 IF(NODE(L2,1).EQ.0) GO TO 112
02400 IF (NODE(L1,1).NE.0) GO TO 113
02500 LA=L2
02600 L2=L1
02700 L1=LA
02800 112 STACK(S+1)=L2
02900 STACK(S+2)=0
03000 S=S+2
03100 LV=LV+1
03200 IA=CONN(L2,1)
03300 XMN=0
03400 XMX=100
03500 YMN=0
03600 YMX=100
03700 RB=RA
03800 IF (LN.GT.NXN) RB=1
03900 IF (LV.NE.2) GO TO 116
04000 XMN=51
04100 YMN=50
04200 116 DO 110 I=2,IA
04300 IB=CONN(L2,I)
04400 N1=NODE(IB,1)
04500 IF (N1.EQ.0) GO TO 110
04600 XMN=MAX0(XMN,N1-RB)
04700 XMX=MIN0(XMX,N1+RB)
04800 N2=NODE(IB,2)
04900 YMN=MAX0(YMN,N2-RB)
05000 YMX=MIN0(YMX,N2+RB)
05100 110 CONTINUE
05200 IF (XMN.GT.XMX.OR.YMN.GT.YMX) GO TO 120
05300 NA=NODE(L2,4)
05400 DO 111 IX=XMN,XMX
05500 DO 111 IY=YMN,YMX
05600 IF (NA.LE.0) GO TO 157
05700 NB=IY*SX-IX*SY+50*(IX-IY+SY-SX)
05800 IF (NB.LT.0) GO TO 111
05900 157 CONTINUE
06000 STACK(S+1)=IY
06100 STACK(S+2)=IX
06200 STACK(S+3)=L2
06300 S=S+3
06400 111 CONTINUE
06500 GO TO 120
06600 113 IF (RTLIN(LN).NE.0) GO TO 122
06700 S=S+2
06800 STACK(S-1)=0
06900 STACK(S)=0
07000 LV=LV+1
07100 105 LN=LN+1
07200 IF (LN.LE.LLN) GO TO 114
07300 GO TO 300
07400 C
07500 C NEXT
07600 C
07700 122 LN=LN-1
07800 120 N0=STACK(S)
07900 IF (N0.LE.0) GO TO 130
08000 NX=STACK(S-1)
08100 NY=STACK(S-2)
08200 NODE(N0,1)=0
08300 IF (LV.NE.2) GO TO 158
08400 SX=NX
08500 SY=NY
08600 158 CONTINUE
08700 S=S-3
08800 DO 121 I=1,NLN
08900 IF (NX.EQ.NODE(I,1).AND.NY.EQ.NODE(I,2)) GO TO 120
09000 121 CONTINUE
09100 NODE(N0,1)=NX
09200 NODE(N0,2)=NY
09300 IF (RTLIN(LN).EQ.0) GO TO 105
09400 NODE(N0,1)=0
09500 GO TO 120
09600 C
09700 C POP
09800 C
09900 130 LV=LV-1
10000 LN=LN-1
10100 IF (N0.LT.0) GO TO 140
10200 N1=STACK(S-1)
10300 S=S-2
10400 IF (N1.EQ.0) GO TO 131
10500 NODE(N1,1)=0
10600 NODE(N1,2)=0
10700 131 GO TO 120
10800 C
10900 C FAIL
11000 C
11100 140 RA=RA+1
11200 IF (RA.LE.3) GO TO 50
11300 RI=1
11400 GO TO 50
00100 C OUTPUT ROUTINES
00200 C
00300 300 CONTINUE
00400 302 NTB=1
00500 NDB=1
00600 DO 305 I=1,LLN
00700 IF (LINE(I,3).EQ.2) NDB=NDB+1
00800 305 IF (LINE(I,3).EQ.3) NTB=NTB+1
00900 BN(NTB,NDB)=BN(NTB,NDB)+1
01000 1010 FORMAT(1H0,19H LOCATIONS OF NODES/5H NODE,5X,5HX-POS,5X,5HY-POS)
01100 DO 301 I=1,NLN
01200 301 CONTINUE
01300 1011 FORMAT(1X,I3,5X,I5,5X,I5)
01400 CALL DRPIC(0)
01500 GO TO 30
01600 C
01700 C
01800 C END OF MAIN PROGRAM
01900 C
02000 END
00100 INTEGER FUNCTION RTLIN(L)
00200 IMPLICIT INTEGER(A-Z)
00300 COMMON LINE(20,4),NODE(20,4),STACK(1000)
00400 COMMON LLN,NLN,S,LA,FLN,RA,RI
00500 COMMON /COMMAT/ N(10,2),IA,LX1,LY1,LX2,LY2,ND1
00600 DATA RINT,ROVL,RLEN,RTRI,RSQR,RHEX/48,2048,16,32,32,32/
00700 REAL X,Y,SL,B,SLA,BA,FLOAT
00800 RTLIN=0
00900 L1=LINE(L,1)
01000 L2=LINE(L,2)
01100 LX1=NODE(L1,1)
01200 LX2=NODE(L2,1)
01300 LY1=NODE(L1,2)
01400 LY2=NODE(L2,2)
01500 C
01600 C CHECK FOR INTERSECT AND OVERLAP
01700 C
01800 IF (LX2.NE.LX1) GO TO 421
01900 SL=1024
02000 B=LX1
02100 GO TO 420
02200 421 SL=FLOAT(LY2-LY1)/FLOAT(LX2-LX1)
02300 B=LY2-SL*LX2
02400 420 IA=L-1
02500 IF (L.EQ.1) GO TO 404
02600 DO 400 I=1,IA
02700 LL1=LINE(I,1)
02800 LL2=LINE(I,2)
02900 LLX1=NODE(LL1,1)
03000 LLX2=NODE(LL2,1)
03100 LLY1=NODE(LL1,2)
03200 LLY2=NODE(LL2,2)
03300 IF (LLX2.NE.LLX1) GO TO 422
03400 SLA=1024
03500 BA=LLX2
03600 GO TO 423
03700 422 SLA=FLOAT(LLY2-LLY1)/FLOAT(LLX2-LLX1)
03800 BA=LLY2-SLA*LLX2
03900 423 IF (SL.EQ.SLA) GO TO 401
04000 IF (LL1.EQ.L1.OR.LL1.EQ.L2.OR.LL2.EQ.L1.OR.LL2.EQ.L2) GO TO 400
04100 IF (SL .EQ. 1024) GO TO 405
04200 IF (SLA.EQ. 1024) GO TO 406
04300 X=(BA-B)/(SL-SLA)
04400 Y=SL*X+B
04500 407 IF (X.GT.MAX0(LX1,LX2) .OR. X.LT.MIN0(LX1,LX2)) GO TO 400
04600 IF (X.GT.MAX0(LLX1,LLX2).OR.X.LT.MIN0(LLX1,LLX2)) GO TO 400
04700 IF (Y.GT.MAX0(LY1,LY2) .OR. Y.LT.MIN0(LY1,LY2)) GO TO 400
04800 IF (Y.GT.MAX0(LLY1,LLY2).OR.Y.LT.MIN0(LLY1,LLY2)) GO TO 400
04900 408 RTLIN=RTLIN+RINT*(1-RI)
05000 GO TO 400
05100 405 Y=SLA*B+BA
05200 X=B
05300 GO TO 407
05400 406 Y=SL*BA+B
05500 X=BA
05600 GO TO 407
05700 401 IF (B .NE. BA) GO TO 400
05800 IF (SL .EQ. 1024) GO TO 402
05900 IF (MAX0(LX1,LX2).LE.MIN0(LLX1,LLX2)) GO TO 400
06000 IF (MIN0(LX1,LX2).GE.MAX0(LLX1,LLX2)) GO TO 400
06100 GO TO 403
06200 402 IF (MAX0(LY1,LY2).LE.MIN0(LLY1,LLY2)) GO TO 400
06300 IF (MIN0(LY1,LY2).GE.MAX0(LLY1,LLY2)) GO TO 400
06400 403 GO TO 411
06500 400 CONTINUE
06600 404 CONTINUE
06700 508 RETURN
06800 C
06900 C FAILURE
07000 C
07100 411 RTLIN=RTLIN+ROVL
07200 RETURN
07300 END
00100 SUBROUTINE SLOPE(I,S,B)
00200 COMMON LINE(20,4),NODE(20,4),STACK(1000)
00300 COMMON LLN,NLN,XSX,L,FLN,RA,RI
00400 INTEGER STACK,FACE,XSX,FLN
00500 Y1=FLOAT(NODE(LINE(I,1),2))
00600 Y2=FLOAT(NODE(LINE(I,2),2))
00700 X1=FLOAT(NODE(LINE(I,1),1))
00800 X2=FLOAT(NODE(LINE(I,2),1))
00900 IF (X2.EQ.X1) GO TO 801
01000 S=(Y2-Y1)/(X2-X1)
01100 B=Y2-S*X2
01200 RETURN
01300 801 S=1024
01400 B=X2
01500 RETURN
01600 END
01700 INTEGER FUNCTION INC(N,L)
01800 I=(1+IFIX(SQRT(FLOAT(1+N))))/2
01900 IA=N-4*I*(I-1)
02000 IC=MOD(IA/4+I,2*I+1)-I
02100 IB=MOD(IA,4)/2
02200 ID=MOD(IA,2)*2-1
02300 IX=I*ID*(IB-1)+IB*IC*ID
02400 IY=I*ID*IB+(1-IB)*IC*ID
02500 INC=IX
02600 IF (L.EQ.2) INC=IY
02700 RETURN
02800 END
00100 SUBROUTINE PMATCH(IPAT,IPA,IPB,IPC,IFLG,ITMP,NXN)
00200 IMPLICIT INTEGER (A-Z)
00300 COMMON LINE(20,4),NODE(20,4),STACK(1000)
00400 COMMON LLN,NLN,S,L,FLN,RA,RI
00500 DIMENSION IPAT(IPA,IPB,IPC),ITMP(20)
00600 IFA=IFLG
00700 IFLG=0
00800 IF (1.EQ.1) RETURN
00900 IF (NXN.EQ.0) RETURN
01000 DO 86 J=IFA,IPC
01100 IF (IPAT(1,NXN,J).EQ.0.OR.IPAT(1,NXN+1,J).NE.0) GO TO 86
01200 DO 85 I=1,NLN
01300 DO 87 IA=1,NLN
01400 87 ITMP(IA)=0
01500 ITMP(IPAT(1,1,J))=I
01600 IA=0
01700 89 IA=IA+1
01800 IP1=IPAT(1,IA,J)
01900 IP2=IPAT(2,IA,J)
02000 IP3=0
02100 IF (IP1.EQ.0) GO TO 93
02200 IF (ITMP(IP2).NE.0) GO TO 94
02300 IP3=1
02400 ITMP(IP2)=1
02500 91 DO 88 IB=1,NLN
02600 IF (IB.NE.IP2.AND.ITMP(IP2).EQ.ITMP(IB)) GO TO 92
02700 88 CONTINUE
02800 94 ITMP(10+IA)=IP3
02900 DO 90 IB=1,LLN
03000 IF (LINE(IB,1).EQ.ITMP(IP1).AND.LINE(IB,2).EQ.ITMP(IP2)) GO TO 89
03100 IF (LINE(IB,1).EQ.ITMP(IP2).AND.LINE(IB,2).EQ.ITMP(IP1)) GO TO 89
03200 90 CONTINUE
03300 IF (IP3.EQ.0) GO TO 95
03400 92 ITMP(IP2)=ITMP(IP2)+1
03500 IF (ITMP(IP2).LE.NLN) GO TO 91
03600 95 IA=IA-1
03700 IF (IA.EQ.0) GO TO 85
03800 IP1=IPAT(1,IA,J)
03900 IP2=IPAT(2,IA,J)
04000 IP3=ITMP(IA+10)
04100 GO TO 92
04200 85 CONTINUE
04300 GO TO 86
04400 93 IFLG=J
04500 RETURN
04600 86 CONTINUE
04700 RETURN
04800 END
00100 SUBROUTINE DRPIC(IFLG)
00200 IMPLICIT INTEGER(A-Z)
00300 COMMON LINE(20,4),NODE(20,4),STACK(1000)
00400 COMMON LLN,NLN,S,LA,FLN,RA,RI
00500 COMMON /PRIPLO/ AMODES(200),PFLD(50,50)
00600 REAL AMODES
00700 DATA SP/1H /
00800 DO 612 I=1,30
00900 DO 612 IA=1,30
01000 612 PFLD(I,IA)=SP
01100 CALL SCALE(IFLG)
01200 DO 610 I=1,NLN
01300 610 CALL DNODE(I,IFLG)
01400 DO 611 I=1,LLN
01500 611 CALL DLINE(I,IFLG)
01600 CALL DNPIC(IFLG)
01700 RETURN
01800 END
00100 SUBROUTINE SCALE (IFLG)
00200 IMPLICIT INTEGER(A-Z)
00300 COMMON LINE(20,4),NODE(20,4),STACK(1000)
00400 COMMON LLN,NLN,S,LA,FLN,RA,RI
00500 COMMON /PRIPLO/ AMODES(200),PFLD(50,50)
00600 REAL AMODES
00700 REAL FLOAT
00800 XMX=0
00900 YMX=0
01000 XMN=10000
01100 YMN=10000
01200 DO 601 I=1,NLN
01300 XMX=MAX0(XMX,NODE(I,1))
01400 YMX=MAX0(YMX,NODE(I,2))
01500 XMN=MIN0(XMN,NODE(I,1))
01600 601 YMN=MIN0(YMN,NODE(I,2))
01700 IF (IFLG.EQ.0) GO TO 602
01800 C CALL MODESG(AMODES,'L MASINTER, 130, PGM=DRAWER',24)
01900 C CALL SUBJEC(AMODES,FLOAT(XMN),FLOAT(YMN),FLOAT(XMX),FLOAT(YMX))
02000 RETURN
02100 602 AMODES(1)=FLOAT(XMN)
02200 AMODES(2)=FLOAT(YMN)
02300 AMODES(3)=FLOAT(4*XMX-4*XMN)+1.0
02400 AMODES(4)=FLOAT(4*YMX-4*YMN)+1.0
02500 RETURN
02600 END
00100 SUBROUTINE DNODE(I,IFLG)
00200 IMPLICIT INTEGER(A-Z)
00300 COMMON LINE(20,4),NODE(20,4),STACK(1000)
00400 COMMON LLN,NLN,S,LA,FLN,RA,RI
00500 COMMON /PRIPLO/ AMODES(200),PFLD(50,50)
00600 REAL X,Y,AMODES
00700 REAL FLOAT
00800 IF (IFLG.EQ.0) GO TO 620
00900 X=FLOAT(NODE(I,1))
01000 Y=FLOAT(NODE(I,2))
01100 C CALL VECSG(AMODES,X,Y,1,NODE(I,3))
01200 RETURN
01300 620 IX=(NODE(I,1)-AMODES(1))*4+1
01400 IY=(NODE(I,2)-AMODES(2))*4+1
01500 PFLD(IX,IY)=NODE(I,3)
01600 RETURN
01700 END
00100 SUBROUTINE DLINE(I,IFLG)
00150 COMMON/OFN/OFN
00200 IMPLICIT INTEGER(A-Z)
00300 COMMON LINE(20,4),NODE(20,4),STACK(1000)
00400 COMMON LLN,NLN,S,LA,FLN,RA,RI
00500 COMMON /PRIPLO/ AMODES(200),PFLD(50,50)
00600 REAL B,AMODES,X,Y
00700 REAL FLOAT
00800 DIMENSION CHR(5),X(2),Y(2)
00900 DATA CHR/1H*,1H=,1H3,1H4,1H5/
01000 IF (IFLG.EQ.0) GO TO 630
01100 X(1)=FLOAT(NODE(LINE(I,1),1))
01200 X(2)=FLOAT(NODE(LINE(I,2),1))
01300 Y(1)=FLOAT(NODE(LINE(I,1),2))
01400 Y(2)=FLOAT(NODE(LINE(I,2),2))
01500 C CALL LINESG(AMODES,2,X,Y)
01600 RETURN
01700 630 IX1=(NODE(LINE(I,1),1)-AMODES(1))*4+1
01800 IX2=(NODE(LINE(I,2),1)-AMODES(1))*4+1
01900 IY1=(NODE(LINE(I,1),2)-AMODES(2))*4+1
02000 IY2=(NODE(LINE(I,2),2)-AMODES(2))*4+1
02100 DY=IY2-IY1
02200 DX=IX2-IX1
02300 IF (IABS(DY).GT.IABS(DX)) GO TO 635
02400 IDX=ISIGN(1,DX)
02500 IX=IX1+IDX
02600 B=IY1-FLOAT(DY)/FLOAT(DX)*IX1
02700 631 IY=FLOAT(DY)/FLOAT(DX)*IX+B+0.5
02800 PFLD(IX,IY)=CHR(LINE(I,3))
02900 IX=IX+IDX
03000 IF(IX.NE.IX2) GO TO 631
03100 RETURN
03200 635 IDY=ISIGN(1,DY)
03300 IY=IY1+IDY
03400 B=IX1-FLOAT(DX)/FLOAT(DY)*IY1
03500 632 IX=FLOAT(DX)/FLOAT(DY)*IY+B+0.5
03600 PFLD(IX,IY)=CHR(LINE(I,3))
03700 IY=IY+IDY
03800 IF(IY.NE.IY2) GO TO 632
03900 RETURN
04000 END
00100 SUBROUTINE DNPIC(IFLG)
00150 COMMON/OFN/OFN
00200 IMPLICIT INTEGER(A-Z)
00300 COMMON LINE(20,4),NODE(20,4),STACK(1000)
00400 COMMON LLN,NLN,S,LA,FLN,RA,RI
00500 COMMON /PRIPLO/ AMODES(200),PFLD(50,50)
00600 REAL AMODES
00700 IF (IFLG.EQ.0) GO TO 640
00800 C CALL EXITG(AMODES)
00900 RETURN
01000 640 IX=AMODES(3)
01100 IY=AMODES(4)
01200 643 FORMAT(///)
01300 DO 641 I=1,IY
01400 641 WRITE(OFN,642) (PFLD(IA,I),IA=1,IX)
01500 642 FORMAT(1H ,50A1)
01600 RETURN
01700 END